home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue52 / Alfresco / StrStuff.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-10-31  |  2.9 KB  |  130 lines
  1. unit StrStuff;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Edit1: TEdit;
  12.     Label1: TLabel;
  13.     Button1: TButton;
  14.     Button2: TButton;
  15.     Label2: TLabel;
  16.     Label3: TLabel;
  17.     Label4: TLabel;
  18.     Button3: TButton;
  19.     procedure Button1Click(Sender: TObject);
  20.     procedure Button2Click(Sender: TObject);
  21.     procedure Button3Click(Sender: TObject);
  22.   private
  23.     { Private declarations }
  24.   public
  25.     { Public declarations }
  26.     TestStr : string;
  27.   end;
  28.  
  29. var
  30.   Form1: TForm1;
  31.  
  32. implementation
  33.  
  34. {$R *.DFM}
  35.  
  36. procedure AAGetStringData(const aSt       : string;
  37.                             var aLen      : integer;
  38.                             var aRefCount : integer;
  39.                             var aAllocSize: integer);
  40. type
  41.   PLongint = ^longint;
  42. var
  43.   StringPtr : PLongint;
  44. begin
  45.   if (aSt = '') then begin
  46.     aLen := 0;
  47.     aRefCount := -1;
  48.     aAllocSize := -1;
  49.   end
  50.   else begin
  51.     StringPtr := pointer(aSt);
  52.     dec(PChar(StringPtr), sizeof(longint));
  53.     aLen := StringPtr^;
  54.     dec(PChar(StringPtr), sizeof(longint));
  55.     aRefCount := StringPtr^;
  56.     if (aRefCount = -1) then
  57.       aAllocSize := -1
  58.     else begin
  59.       dec(PChar(StringPtr), sizeof(longint));
  60.       aAllocSize := StringPtr^ and $7FFFFFFC;
  61.     end;
  62.   end;
  63. end;
  64.  
  65. procedure AAIncStringRefCount(var aSt : string);
  66. type
  67.   PLongint = ^longint;
  68. var
  69.   StringPtr : PLongint;
  70. begin
  71.   if (aSt <> '') then begin
  72.     StringPtr := pointer(aSt);
  73.     dec(PChar(StringPtr), 2 * sizeof(longint));
  74.     if (StringPtr^ <> -1) then
  75.       inc(StringPtr^);
  76.   end;
  77. end;
  78.  
  79. procedure AADecStringRefCount(var aSt : string);
  80. type
  81.   PLongint = ^longint;
  82. var
  83.   StringPtr : PLongint;
  84. begin
  85.   if (aSt <> '') then begin
  86.     StringPtr := pointer(aSt);
  87.     dec(PChar(StringPtr), 2 * sizeof(longint));
  88.     if (StringPtr^ = 1) then
  89.       aSt := ''
  90.     else if (StringPtr^ > 1) then
  91.       dec(StringPtr^);
  92.   end;
  93. end;
  94.  
  95. procedure TForm1.Button1Click(Sender: TObject);
  96. var
  97.   Len, RefCount, AllocSize : longint;
  98. begin
  99.   TestStr := Edit1.Text;
  100.   Edit1.Text := '';
  101.   AAGetStringData(TestStr, Len, RefCount, AllocSize);
  102.   Label2.Caption := IntToStr(Len);
  103.   Label3.Caption := IntToStr(RefCount);
  104.   Label4.Caption := IntToStr(AllocSize);
  105. end;
  106.  
  107. procedure TForm1.Button2Click(Sender: TObject);
  108. var
  109.   Len, RefCount, AllocSize : longint;
  110. begin
  111.   AAIncStringRefCount(TestStr);
  112.   AAGetStringData(TestStr, Len, RefCount, AllocSize);
  113.   Label2.Caption := IntToStr(Len);
  114.   Label3.Caption := IntToStr(RefCount);
  115.   Label4.Caption := IntToStr(AllocSize);
  116. end;
  117.  
  118. procedure TForm1.Button3Click(Sender: TObject);
  119. var
  120.   Len, RefCount, AllocSize : longint;
  121. begin
  122.   AADecStringRefCount(TestStr);
  123.   AAGetStringData(TestStr, Len, RefCount, AllocSize);
  124.   Label2.Caption := IntToStr(Len);
  125.   Label3.Caption := IntToStr(RefCount);
  126.   Label4.Caption := IntToStr(AllocSize);
  127. end;
  128.  
  129. end.
  130.